home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_l.arc / PROGS.ARC / press.icn < prev    next >
Encoding:
Text File  |  1990-03-08  |  11.3 KB  |  416 lines
  1. ############################################################################
  2. #
  3. #    Name:    press.icn
  4. #
  5. #    Title:    LZW Compression and Decompression Utility
  6. #
  7. #    Author:    Robert J. Alexander
  8. #
  9. #    Date:    December 5, 1989
  10. #
  11. ############################################################################
  12. #
  13. #  Note:  This program is designed primarily to demonstrate the LZW
  14. #         compression process.  It contains a lot of tracing toward
  15. #         that end and is too slow for practical use.
  16. #
  17. ############################################################################
  18. #
  19. #  Usage: press [-t] -c [-s n] [-f <compressed file>] <file to compress>...
  20. #         press [-t] -x <compressed file>...
  21. #
  22. #  -c  perform compression
  23. #  -x  expand (decompress) compressed file
  24. #  -f  output file for compression -- if missing standard output used
  25. #  -s  maximum string table size
  26. #       (for compression only -- default = 1024)
  27. #  -t  output trace info to standard error file
  28. #
  29. #  If the specified maximum table size is positive, the string table is
  30. #  discarded when the maximum size is reached and rebuilt (recommended).
  31. #  If negative, the original table is not discarded, which might produce
  32. #  better results in some circumstances.
  33. #
  34. ############################################################################
  35. #
  36. #  Features that might be nice to add someday:
  37. #
  38. #       Allow decompress output to standard output.
  39. #
  40. #       Handle heirarchies.
  41. #
  42. #       Way to list files in archive, and access individual files
  43. #
  44. ############################################################################
  45. #
  46. #  Links: options
  47. #
  48. ############################################################################
  49.  
  50. global inchars,outchars,tinchars,toutchars,lzw_recycles,
  51.       lzw_stringTable,lzw_trace,wr,wrs,rf,wf
  52.  
  53. link options
  54.  
  55. procedure main(arg)
  56.    local compr,expand,fn,maxT,maxTableSize,opt,outfile,wfn
  57.  
  58.    #
  59.    #  Initialize.
  60.    #
  61.    opt := options(arg,"ts+f:cx")
  62.    if *arg = 0 then arg := ["-"]
  63.    lzw_trace := opt["t"]
  64.    expand := opt["x"]
  65.    compr := opt["c"]
  66.    outfile := opt["f"]
  67.    maxTableSize := \opt["s"]
  68.    if (/expand & /compr) then Usage()
  69.    wr := write ; wrs := writes
  70.    inchars := outchars := tinchars := toutchars := lzw_recycles := 0
  71.    #
  72.    #  Process compression.
  73.    #
  74.    if \compr then {
  75.       if \expand then Usage()
  76.       if \outfile then
  77.         wf := open(outfile,"w") | stop("Can't open output file ",outfile)
  78.       #
  79.       #  Loop to process files on command line.
  80.       #
  81.       every fn := !arg do {
  82.      if fn === outfile then next
  83.      wr(&errout,"\nFile \"",fn,"\"")
  84.      rf := if fn ~== "-" then open(fn) | &null else &input
  85.      if /rf then {
  86.         write(&errout,"Can't open input file \"",fn,"\" -- skipped")
  87.         next
  88.         }
  89.      write(wf,tail(fn))
  90.      maxT := compress(r,w,maxTableSize)
  91.      close(rf)
  92.      stats(maxT)
  93.      }
  94.       }
  95.    #
  96.    #  Process decompression.
  97.    #
  98.    else if \expand then {
  99.       if \(compr | outfile | maxTableSize) then Usage()
  100.       #
  101.       #  Loop to process files on command line.
  102.       #
  103.       every fn := !arg do {
  104.      rf := if fn ~== "-" then open(fn) | &null else &input
  105.      if /rf then {
  106.         write(&errout,"Can't open input file \"",fn,"\" -- skipped")
  107.         next
  108.         }
  109.      while wfn := read(rf) do {
  110.         wr(&errout,"\nFile \"",wfn,"\"")
  111.         wf := open(wfn,"w") | &null
  112.         if /wf then {
  113.            write(&errout,"Can't open output file \"",wfn,"\" -- quitting")
  114.            exit(1)
  115.            }
  116.         maxT := decompress(r,w)
  117.         close(wf)
  118.         stats(maxT)
  119.         }
  120.      close(rf)
  121.      }
  122.       }
  123.    else Usage()
  124.    #
  125.    #  Write statistics
  126.    #
  127.    wr(&errout,"\nTotals: ",
  128.      "\n  input = ",tinchars,
  129.      "\n  output = ",toutchars,
  130.      "\n  compression factor = ",(real(toutchars) / real(0 < tinchars)) | "")
  131. end
  132.  
  133.  
  134. procedure stats(maxTableSize)
  135.    #
  136.    #  Write statistics
  137.    #
  138.    wr(&errout,
  139.      "  input = ",inchars,
  140.      "\n  output = ",outchars,
  141.      "\n  compression factor = ",(real(outchars) / real(0 < inchars)) | "",
  142.      "\n  table size = ",*lzw_stringTable,"/",maxTableSize,
  143.      " (",lzw_recycles," recycles)")
  144.    tinchars +:= inchars
  145.    toutchars +:= outchars
  146.    inchars := outchars := lzw_recycles := 0
  147.    return
  148. end
  149.  
  150.  
  151. procedure r()
  152.    return 1(reads(rf),inchars +:= 1)
  153. end
  154.  
  155.  
  156. procedure w(s)
  157.    return 1(writes(wf,s),outchars +:= *s)
  158. end
  159.  
  160.  
  161. procedure Usage()
  162.    stop("_
  163. #  Usage: icompress [-t] -c [-s n] <file to compress>...\n_
  164. #         icompress [-t] -x <compressed file>...\n_
  165. #\n_
  166. #  -c  perform compression\n_
  167. #  -x  expand (decompress) compressed file\n_
  168. #  -f  output file for compression -- if missing standard output used\n_
  169. #  -s  maximum string table size\n_
  170. #       (for compression only -- default = 1024)\n_
  171. #  -t  output trace info to standard error file\n_
  172. #")
  173. end
  174.  
  175. procedure tail(fn)
  176.    local i
  177.    i := 0
  178.    every i := find("/",fn)
  179.    return fn[i + 1:0]
  180. end
  181.  
  182. #
  183. #  compress() -- LZW compression
  184. #
  185. #  Arguments:
  186. #
  187. #    inproc    a procedure that returns a single character from
  188. #        the input stream.
  189. #
  190. #    outproc    a procedure that writes a single character (its
  191. #        argument) to the output stream.
  192. #
  193. #    maxTableSize    the maximum size to which the string table
  194. #        is allowed to grow before something is done about it.
  195. #        If the size is positive, the table is discarded and
  196. #        a new one started.  If negative, it is retained, but
  197. #        no new entries are added.
  198. #
  199.  
  200. procedure compress(inproc,outproc,maxTableSize)
  201.    local EOF,c,charTable,junk1,junk2,outcode,s,t,
  202.      tossTable,x
  203.    #
  204.    #  Initialize.
  205.    #
  206.    /maxTableSize := 1024    # 10 "bits"
  207.    every outproc(!string(maxTableSize))
  208.    outproc("\n")
  209.    tossTable := maxTableSize
  210.    /lzw_recycles := 0
  211.    if maxTableSize < 0 then maxTableSize := -maxTableSize
  212.    charTable := table()
  213.    every c := !&cset do charTable[c] := ord(c)
  214.    EOF := charTable[*charTable] := *charTable    # reserve code=256 for EOF
  215.    lzw_stringTable := copy(charTable)
  216.    #
  217.    #  Compress the input stream.
  218.    #
  219.    s := inproc() | return maxTableSize
  220.    if \lzw_trace then {
  221.       wr(&errout,"\nInput string\tOutput code\tNew table entry")
  222.       wrs(&errout,"\"",image(s)[2:-1])
  223.       }
  224.    while c := inproc() do {
  225.    if \lzw_trace then
  226.      wrs(&errout,image(c)[2:-1])
  227.       if \lzw_stringTable[t := s || c] then s := t
  228.       else {
  229.      compress_output(outproc,junk2 := lzw_stringTable[s],junk1 := *lzw_stringTable)
  230.      if *lzw_stringTable < maxTableSize then
  231.            lzw_stringTable[t] := *lzw_stringTable
  232.      else if tossTable >= 0 then {
  233.            lzw_stringTable := copy(charTable)
  234.            lzw_recycles +:= 1
  235.         }
  236.      if \lzw_trace then
  237.            wrs(&errout,"\"\t\t",
  238.              image(char(*&cset > junk2) | junk2),
  239.              "(",junk1,")\t\t",lzw_stringTable[t]," = ",image(t),"\n\"")
  240.      s := c
  241.      }
  242.       }
  243.    compress_output(outproc,lzw_stringTable[s],*lzw_stringTable)
  244.    if \lzw_trace then
  245.      wr(&errout,"\"\t\t",
  246.            image(char(*&cset > (x := \lzw_stringTable[s] | 0)) | x))
  247.    compress_output(outproc,EOF,*lzw_stringTable)
  248.    compress_output(outproc)
  249.    return maxTableSize
  250. end
  251.  
  252.  
  253. procedure compress_output(outproc,code,stringTableSize)
  254.    local outcode
  255.    static max,bits,buffer,bufferbits,lastSize
  256.    #
  257.    #  Initialize.
  258.    #
  259.    initial {
  260.       lastSize := 1000000
  261.       buffer := bufferbits := 0
  262.       }
  263.    #
  264.    #  If this is "close" call, flush buffer and reinitialize.
  265.    #
  266.    if /code then {
  267.       outcode := &null
  268.       if bufferbits > 0 then
  269.         outproc(char(outcode := ishift(buffer,8 - bufferbits)))
  270.       lastSize := 1000000
  271.       buffer := bufferbits := 0
  272.       return outcode
  273.       }
  274.    #
  275.    #  Expand output code size if necessary.
  276.    #
  277.    if stringTableSize < lastSize then {
  278.       max := 1
  279.       bits := 0
  280.       }
  281.    while stringTableSize > max do {
  282.       max *:= 2
  283.       bits +:= 1
  284.       }
  285.    lastSize := stringTableSize
  286.    #
  287.    #  Merge new code into buffer.
  288.    #
  289.    buffer := ior(ishift(buffer,bits),code)
  290.    bufferbits +:= bits
  291.    #
  292.    #  Output bits.
  293.    #
  294.    while bufferbits >= 8 do {
  295.       outproc(char(outcode := ishift(buffer,8 - bufferbits)))
  296.       buffer := ixor(buffer,ishift(outcode,bufferbits - 8))
  297.       bufferbits -:= 8
  298.       }
  299.    return outcode
  300. end
  301.  
  302. ############################################################################
  303. #
  304. #  decompress() -- LZW decompression of compressed stream created
  305. #                  by compress()
  306. #
  307. #  Arguments:
  308. #
  309. #    inproc    a procedure that returns a single character from
  310. #        the input stream.
  311. #
  312. #    outproc    a procedure that writes a single character (its
  313. #        argument) to the output stream.
  314. #
  315.  
  316. procedure decompress(inproc,outproc)
  317.    local EOF,c,charSize,code,i,maxTableSize,new_code,old_strg,
  318.      strg,tossTable
  319.    #
  320.    #  Initialize.
  321.    #
  322.    maxTableSize := ""
  323.    while (c := inproc()) ~== "\n" do maxTableSize ||:= c
  324.    maxTableSize := integer(maxTableSize) |
  325.      stop("Invalid file format -- max table size missing")
  326.    tossTable := maxTableSize
  327.    /lzw_recycles := 0
  328.    if maxTableSize < 0 then maxTableSize := -maxTableSize
  329.    maxTableSize -:= 1
  330.    lzw_stringTable := list(*&cset)
  331.    every i := 1 to *lzw_stringTable do lzw_stringTable[i] := char(i - 1)
  332.    put(lzw_stringTable,EOF := *lzw_stringTable)  # reserve code=256 for EOF
  333.    charSize := *lzw_stringTable
  334.    if \lzw_trace then
  335.      wr(&errout,"\nInput code\tOutput string\tNew table entry")
  336.    #
  337.    #  Decompress the input stream.
  338.    #
  339.    while old_strg :=
  340.      lzw_stringTable[decompress_read_code(inproc,*lzw_stringTable,EOF) + 1] do {
  341.       if \lzw_trace then
  342.         wr(&errout,image(old_strg),"(",*lzw_stringTable,")",
  343.           "\t",image(old_strg))
  344.       outproc(old_strg)
  345.       c := old_strg[1]
  346.       (while new_code := decompress_read_code(inproc,*lzw_stringTable + 1,EOF) do {
  347.      strg := lzw_stringTable[new_code + 1] | old_strg || c
  348.      outproc(strg)
  349.      c := strg[1]
  350.      if \lzw_trace then
  351.            wr(&errout,image(char(*&cset > new_code) \ 1 | new_code),
  352.              "(",*lzw_stringTable + 1,")","\t",
  353.              image(strg),"\t\t",
  354.              *lzw_stringTable," = ",image(old_strg || c))
  355.      if *lzw_stringTable < maxTableSize then
  356.            put(lzw_stringTable,old_strg || c)
  357.      else if tossTable >= 0 then {
  358.         lzw_stringTable := lzw_stringTable[1:charSize + 1]
  359.         lzw_recycles +:= 1
  360.         break
  361.         }
  362.      old_strg := strg
  363.      }) | break  # exit outer loop if this loop completed
  364.       }
  365.    decompress_read_code()
  366.    return maxTableSize
  367. end
  368.  
  369.  
  370. procedure decompress_read_code(inproc,stringTableSize,EOF)
  371.    local code
  372.    static max,bits,buffer,bufferbits,lastSize
  373.  
  374.    #
  375.    #  Initialize.
  376.    #
  377.    initial {
  378.       lastSize := 1000000
  379.       buffer := bufferbits := 0
  380.       }
  381.    #
  382.    #  Reinitialize if called with no arguments.
  383.    #
  384.    if /inproc then {
  385.       lastSize := 1000000
  386.       buffer := bufferbits := 0
  387.       return
  388.       }
  389.    #
  390.    #  Expand code size if necessary.
  391.    #
  392.    if stringTableSize < lastSize then {
  393.       max := 1
  394.       bits := 0
  395.       }
  396.    while stringTableSize > max do {
  397.       max *:= 2
  398.       bits +:= 1
  399.       }
  400.    #
  401.    #  Read in more data if necessary.
  402.    #
  403.    while bufferbits < bits do {
  404.       buffer := ior(ishift(buffer,8),ord(inproc())) |
  405.         stop("Premature end of file")
  406.       bufferbits +:= 8
  407.       }
  408.    #
  409.    #  Extract code from buffer and return.
  410.    #
  411.    code := ishift(buffer,bits - bufferbits)
  412.    buffer := ixor(buffer,ishift(code,bufferbits - bits))
  413.    bufferbits -:= bits
  414.    return EOF ~= code
  415. end
  416.